home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
SPACE 1
/
SPACE - Library 1 - Volume 1.iso
/
program
/
363
/
xprolog2
/
_boot
next >
Wrap
Text File
|
1985-11-19
|
6KB
|
221 lines
/*
* X PROLOG Vers. 2.0
*
*
* Written by : Andreas Toenne
* CS Dept. , IRB
* University of Dortmund, W-Germany
* <atoenne@unido.uucp>
* <....!seismo!unido!atoenne>
* <atoenne@unido.bitnet>
*
* Copyright : This software is copyrighted by Andreas Toenne.
* Permission is granted hereby to copy the entire
* package including this copyright notice without fee.
*
*/
% X Prolog Boot File
% hack to create an intermediate goal for call
% this make the cut local to call
call(A) :- $call(A).
% definitions for conjunction and disjunction
% both procedures are made transparent to the cut
(A ; B) :- $call(A).
(A ; B) :- $call(B).
(A , B) :- $call(A), $call(B).
% further predicates
not(Predicate) :- call(Predicate), !, fail.
not(Predicate).
clause(Head, Body) :- $clause(Head, Body, Help). % see the documentation
A = A. % equality predicate :-)
print(Term) :- var(Term), !, write(Term).
print(Term) :- portray(Term). % portray should be user defined
append([],L,L). % common append procedure
append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
member(X, [X|_]). % common member procedure
member(X, [_|Y]) :- member(X, Y).
% toplevel interpreter loop
% the main goal should not be changed
main :- $loop(toplevel). % start things
main. % just to make Xprolog happy
% this is a failure driven loop
$loop(toplevel) :-
prompt(Old, '| '), % change the default prompt
repeat, % loop forever
$prompt('?- '), % give a prompt
read(Term), % wait for response
$solve(Term, toplevel), % solve the query
prompt(_, Old), % restore the prompt
!.
$loop(Where) :- % loop not at top level
prompt(Old, '| '), % different default prompt
repeat, % round and round again
prompt_if_user, % no prompt for files
read(Term), % read something
$solve(Term, Where), % solve it
prompt(_, Old), % restore the prompt
!.
prompt_if_user :- seeing(user), $prompt('| '), !.
prompt_if_user.
$solve(end_of_file, _) :- !. % the only way to stop the repeat
$solve(Term, _) :- var(Term), !, fail. % don't accept strange goals
$solve(Term, Where) :- % try to solve it as a goal
$query(Term, Where, Goal, What), % check for sort of question
!,
prompt(Old, '|: '),
$solve_goal(Goal, What), % try to solve a goal
prompt(_, Old),
fail.
$solve(Term, Where) :- % try to assert it
$process(Term, Result), % hook for preprocessors
assertz(Result), % assert it
!,
fail.
$solve(Term, _) :- % assert or $process failed
write('! clause: '),
write(Term),
fail.
% this is a hook to add preprocessors like the grammar rule translator
% to this top level interpreter.
% simply add via 'asserta' another clause for the preprocessor
$process(T,T).
% check the current term for a question or a command
$query(:-(X), _, X, command) :- !. % this is a command
$query(?-(X), _, X, question) :- !. % this is a question
$query(X, toplevel, X, question). % always questions on top level
% this procedure solves goals
% note the use of $more and $goalvars
$solve_goal(Term, command) :- % no answer, no alternatives
call(Term), % try it once
!. % and no further alternatives
$solve_goal(_, command) :- % above clause failed
!,
nl, write('?'), nl. % notify the user
$solve_goal(Term, question) :-
$goalvars(List), % save the reader's symbol table
call(Term), % try the question
$more(Ok), % call(Term) had a alternative ?
$reply(List, Ok), % say 'yes' to the user
nl,
!.
$solve_goal(_, question) :- % above clause failed !
nl,
write(no), % sorry but ...
nl,
!.
$reply(List, Ok) :- % say yes and show variables
$show_variables(List),
write(yes), % horray
Ok = yes, % an alternative ?
$askformore, % check if the user wants it
!.
$reply(_, Ok) :- % no more alternative
Ok = no,
!.
$askformore :- get(X), skip(10), X \== 59. % 59 is ';'
$show_variables([]) :- !.
$show_variables([(Name, Variable)|L]) :-
write(Name),
write(' = '),
write(Variable),
nl,
!,
$show_variables(L).
% consult and friends
% we simply use the top level interpreter for the asserts and queries
[X|Y] :- $process_files([X|Y]).
$process_files([]) :- !.
$process_files([-File|Rest]) :- !, reconsult(File), $process_files(Rest).
$process_files([File|Rest]) :- !, consult(File), $process_files(Rest).
consult(File) :- !, $read_file(File, 0).
reconsult(File) :- !, $read_file(File, 1).
$read_file(File, R) :-
Heap is heapused,
Time is cputime,
$reconsulting(R),
$test_filename(File), % check the file
seeing(OldIn),
telling(OldOut),
see(File), % open the file
$do_loop,
seen, % close the file
see(OldIn),
tell(OldOut),
$reconsulting(0),
DiffTime is cputime - Time,
DiffHeap is heapused - Heap,
write(File),
( R == 0 , write(' consulted ') ;
R == 1 , write(' reconsulted ')),
write(DiffHeap), write(' bytes '),
write(DiffTime), write(' msec.'),
nl, !.
$do_loop :- $loop(filelevel). % loop at filelevel
$do_loop.
$test_filename(user) :- !. % this stream is always ok
$test_filename(File) :-
not atom(File), % invalid name
nl,
write('Invalid filename: '),
write(File),
nl,
!, fail.
$test_filename(File) :-
not exists(File), % file not found
nl,
write('The file '),
write(File),
write(' does not exist.'),
nl,
!, fail.
$test_filename(_). % is ok
%
% debugging hooks
%
leash(off) :- $leash(0).
leash(loose) :- $leash(1).
leash(half) :- $leash(5).
leash(tight) :- $leash(7).
leash(full) :- $leash(15).